home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Coco⁄R / CRX.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  14KB  |  418 lines
  1. Syntax10.Scn.Fnt
  2. MODULE CRX;
  3. IMPORT Oberon, Texts, Sets, CRS, CRT, SYSTEM;
  4. CONST 
  5.     symSetSize  = 100;
  6.     maxTerm     =   3;   (* sets of size < maxTerm are enumerated *)
  7.     tErr = 0; altErr = 1; syncErr = 2;
  8.     EOL = 0DX;
  9.     maxSS:    INTEGER;       (* number of symbol sets *)
  10.     errorNr:  INTEGER;       (* highest parser error number *)
  11.     curSy:    INTEGER;       (* symbol whose production is currently generated *)
  12.     err, w:   Texts.Writer;
  13.     fram:     Texts.Reader;
  14.     src:      Texts.Reader;
  15.     syn:      Texts.Writer;
  16.     scanner:  ARRAY 32 OF CHAR;
  17.     symSet:   ARRAY symSetSize OF CRT.Set;
  18. PROCEDURE Restriction(n: INTEGER);
  19. BEGIN
  20.     Texts.WriteLn(w); Texts.WriteString(w, "Restriction "); 
  21.     Texts.WriteInt(w, n, 0); Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf);
  22.     HALT(99)
  23. END Restriction;
  24. PROCEDURE PutS(s: ARRAY OF CHAR);
  25.     VAR i: INTEGER;
  26. BEGIN i := 0;
  27.     WHILE (i < LEN(s)) & (s[i] # 0X) DO
  28.         IF s[i] = "$" THEN Texts.WriteLn(syn) ELSE Texts.Write(syn, s[i]) END;
  29.         INC(i)
  30. END PutS;
  31. PROCEDURE PutI(i: INTEGER);
  32. BEGIN Texts.WriteInt(syn, i, 0)
  33. END PutI;
  34. PROCEDURE Indent(n: INTEGER);
  35.     VAR i: INTEGER;
  36. BEGIN i := 0; WHILE i < n DO Texts.Write(syn, " "); INC(i) END
  37. END Indent;
  38. PROCEDURE PutSet(s: SET);
  39.     VAR i: INTEGER; first: BOOLEAN;
  40. BEGIN
  41.     i := 0; first := TRUE;
  42.     WHILE i < Sets.size DO
  43.         IF i IN s THEN
  44.             IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
  45.             PutI(i)
  46.         END;
  47.         INC(i)
  48. END PutSet;
  49. PROCEDURE PutSet1(s: CRT.Set);
  50.     VAR i: INTEGER; first: BOOLEAN;
  51. BEGIN
  52.     i := 0; first := TRUE;
  53.     WHILE i <= CRT.maxT DO
  54.         IF Sets.In(s, i) THEN
  55.             IF first THEN first := FALSE ELSE Texts.Write(syn, ",") END;
  56.             PutI(i)
  57.         END;
  58.         INC(i)
  59. END PutSet1;
  60. PROCEDURE Length*(s: ARRAY OF CHAR): INTEGER;
  61.     VAR i: INTEGER;
  62. BEGIN
  63.     i:=0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
  64.     RETURN i
  65. END Length;
  66. PROCEDURE Alternatives(gp: INTEGER): INTEGER;
  67.     VAR gn: CRT.GraphNode; n: INTEGER;
  68. BEGIN
  69.     n := 0;
  70.     WHILE gp > 0 DO
  71.         CRT.GetNode(gp, gn); gp := gn.p2; INC(n)
  72.     END;
  73.     RETURN n
  74. END Alternatives;
  75. PROCEDURE CopyFramePart (stopStr: ARRAY OF CHAR); (*Copy from file <fram> to file <syn> until <stopStr>*)
  76.     VAR ch, startCh: CHAR; i, j, high: INTEGER;
  77. BEGIN
  78.     startCh := stopStr[0]; high := Length(stopStr) - 1; Texts.Read (fram, ch);
  79.     WHILE ch # 0X DO
  80.         IF ch = startCh THEN (* check if stopString occurs *)
  81.             i := 0;
  82.             REPEAT
  83.                 IF i = high THEN RETURN END;  (*stopStr[0..i] found; no unrecognized character*)
  84.                 Texts.Read (fram, ch); INC(i);
  85.             UNTIL ch # stopStr[i];
  86.             (*stopStr[0..i-1] found; 1 unrecognized character*)
  87.             j := 0; WHILE j < i DO Texts.Write(syn, stopStr[j]); INC(j) END
  88.         ELSE Texts.Write (syn, ch); Texts.Read(fram, ch)
  89.         END
  90. END CopyFramePart;
  91. PROCEDURE CopySourcePart (pos: CRT.Position; indent: INTEGER); 
  92. (*Copy sequence <position> from <src> to <syn>*)
  93.     VAR ch: CHAR; i: INTEGER; nChars: LONGINT; r: Texts.Reader;
  94. BEGIN
  95.     IF (pos.beg >= 0) & (pos.len > 0) THEN
  96.         Texts.OpenReader(r, CRS.src, pos.beg); Texts.Read(r, ch);
  97.         nChars := pos.len - 1;
  98.         Indent(indent);
  99.         LOOP
  100.             WHILE ch = EOL DO
  101.                 Texts.WriteLn(syn); Indent(indent);
  102.                 IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
  103.                 i := pos.col;
  104.                 WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
  105.                     IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
  106.                     DEC(i)
  107.                 END
  108.             END;
  109.             Texts.Write (syn, ch);
  110.             IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
  111.         END
  112. (*    IF pos.beg >= 0 THEN
  113.         Texts.OpenReader(r, CRS.src, pos.beg);
  114.         nChars := pos.len; col := pos.col - 1; ch := " ";
  115.         WHILE (nChars > 0) & (ch = " ") DO  (*skip leading blanks*)
  116.             Texts.Read(r, ch); DEC(nChars); INC(col)
  117.         END;
  118.         Indent(indent);
  119.         LOOP
  120.             WHILE ch = EOL DO
  121.                 Texts.WriteLn(syn); Indent(indent);
  122.                 IF nChars > 0 THEN Texts.Read(r, ch); DEC(nChars) ELSE EXIT END;
  123.                 i := col - 1;
  124.                 WHILE (ch = " ") & (i > 0) DO (* skip blanks at beginning of line *)
  125.                     IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END;
  126.                     DEC(i)
  127.                 END
  128.             END;
  129.             Texts.Write (syn, ch);
  130.             IF nChars > 0 THEN Texts.Read(r, ch); DEC (nChars) ELSE EXIT END
  131.         END (* LOOP *)
  132.     END *)
  133. END CopySourcePart;
  134. PROCEDURE GenErrorMsg (errTyp, errSym: INTEGER; VAR errNr: INTEGER);
  135.     VAR i: INTEGER; name: ARRAY 32 OF CHAR; sn: CRT.SymbolNode; 
  136. BEGIN
  137.     INC (errorNr); errNr := errorNr;
  138.     CRT.GetSym (errSym, sn); COPY(sn.name, name);
  139.     i := 0; WHILE name[i] # 0X DO IF name[i] = CHR(34) THEN name[i] := "'" END; INC(i) END;
  140.     Texts.WriteString(err, "  |");
  141.     Texts.WriteInt (err, errNr, 3); Texts.WriteString (err, ": Msg("); Texts.Write(err, CHR(34));
  142.     CASE errTyp OF
  143.     | tErr   : Texts.WriteString (err, name); Texts.WriteString (err, " expected")
  144.     | altErr : Texts.WriteString (err, "invalid "); Texts.WriteString (err, name)
  145.     | syncErr: Texts.WriteString (err, "this symbol not expected in "); Texts.WriteString (err, name)
  146.     END;
  147.     Texts.Write(err, CHR(34)); Texts.Write(err, ")"); Texts.WriteLn(err)
  148. END GenErrorMsg;
  149. PROCEDURE NewCondSet (set: CRT.Set): INTEGER;
  150.     VAR i: INTEGER;
  151. BEGIN
  152.     i := 1; (*skip symSet[0]*)
  153.     WHILE i <= maxSS DO
  154.         IF Sets.Equal(set, symSet[i]) THEN RETURN i END;
  155.         INC(i) 
  156.     END;
  157.     INC(maxSS); IF maxSS > symSetSize THEN Restriction (9) END;
  158.     symSet[maxSS] := set;
  159.     RETURN maxSS
  160. END NewCondSet;
  161. PROCEDURE GenCond (set: CRT.Set);
  162.     VAR sx, i, n: INTEGER;
  163.     PROCEDURE Small(s: CRT.Set): BOOLEAN;
  164.     BEGIN
  165.         i := Sets.size;
  166.         WHILE i <= CRT.maxT DO
  167.             IF Sets.In(set, i) THEN RETURN FALSE END;
  168.             INC(i)
  169.         END;
  170.         RETURN TRUE
  171.     END Small;
  172. BEGIN
  173.     n := Sets.Elements(set, i);
  174.     (*IF n = 0 THEN PutS(" FALSE")  (*this branch should never be taken*)
  175.     ELSIF (n > 1) & Small(set) THEN
  176.         PutS(" sym IN {"); PutSet(set[0]); PutS("} ")
  177.     ELSIF n <= maxTerm THEN
  178.         i := 0;
  179.         WHILE i <= CRT.maxT DO
  180.             IF Sets.In (set, i) THEN
  181.                 PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
  182.                 DEC(n); IF n > 0 THEN PutS(" OR") END
  183.             END;
  184.             INC(i)
  185.         END
  186.     ELSE PutS(" sym IN symSet["); PutI(NewCondSet(set)); PutS(",0]")
  187.     END;*)
  188.     IF n = 0 THEN PutS(" FALSE")  (*this branch should never be taken*)
  189.     ELSIF n <= maxTerm THEN
  190.         i := 0;
  191.         WHILE i <= CRT.maxT DO
  192.             IF Sets.In (set, i) THEN
  193.                 PutS(" (sym = "); PutI(i); Texts.Write(syn, ")");
  194.                 DEC(n); IF n > 0 THEN PutS(" OR") END
  195.             END;
  196.             INC(i)
  197.         END
  198.     ELSE PutS(" StartOf("); PutI(NewCondSet(set)); PutS(") ")
  199.     END;
  200. END GenCond;
  201. PROCEDURE GenCode (gp, indent: INTEGER; checked: CRT.Set);
  202.     VAR gn, gn2: CRT.GraphNode; sn: CRT.SymbolNode; gp2: INTEGER;
  203.             s1, s2: CRT.Set; errNr, alts: INTEGER; equal: BOOLEAN;
  204. BEGIN
  205.     WHILE gp > 0 DO
  206.         CRT.GetNode (gp, gn);
  207.         CASE gn.typ OF
  208.         | CRT.nt:
  209.                 Indent(indent);
  210.                 CRT.GetSym(gn.p1, sn); PutS(sn.name);
  211.                 IF gn.pos.beg >= 0 THEN
  212.                     Texts.Write(syn, "("); CopySourcePart(gn.pos, 0); Texts.Write(syn, ")")
  213.                 END;
  214.                 PutS(";$")
  215.         | CRT.t:
  216.                 CRT.GetSym(gn.p1, sn); Indent(indent);
  217.                 IF Sets.In(checked, gn.p1) THEN
  218.                     PutS("Get;$")
  219.                 ELSE
  220.                     PutS("Expect("); PutI(gn.p1); PutS(");$")
  221.                 END
  222.         | CRT.wt:
  223.                 CRT.CompExpected(ABS(gn.next), curSy, s1);
  224.                 CRT.GetSet(0, s2); Sets.Unite(s1, s2);
  225.                 CRT.GetSym(gn.p1, sn); Indent(indent);
  226.                 PutS("ExpectWeak("); PutI(gn.p1); PutS(", "); PutI(NewCondSet(s1)); PutS(");$")
  227.         | CRT.any:
  228.                 Indent(indent); PutS("Get;$")
  229.         | CRT.eps: (* nothing *)
  230.         | CRT.sem: 
  231.                 CopySourcePart(gn.pos, indent); PutS(";$");
  232.         | CRT.sync:
  233.                 CRT.GetSet(gn.p1, s1);
  234.                 GenErrorMsg (syncErr, curSy, errNr);
  235.                 Indent(indent); 
  236.                 PutS("WHILE ~("); GenCond(s1); PutS(") DO Error(");
  237.                 PutI(errNr); PutS("); Get END;$")
  238.         | CRT.alt:
  239.                 CRT.CompFirstSet(gp, s1); equal := Sets.Equal(s1, checked);
  240.                 alts := Alternatives(gp);
  241.                 IF alts > 5 THEN Indent(indent); PutS("CASE sym OF$") END;
  242.                 gp2 := gp;
  243.                 WHILE gp2 # 0 DO
  244.                     CRT.GetNode(gp2, gn2);
  245.                     CRT.CompExpected(gn2.p1, curSy, s1);
  246.                     Indent(indent);
  247.                     IF alts > 5 THEN PutS("| "); PutSet1(s1); PutS(": ") (*case labels*)
  248.                     ELSIF gp2 = gp THEN PutS("IF"); GenCond(s1); PutS(" THEN$")
  249.                     ELSIF (gn2.p2 = 0) & equal THEN PutS("ELSE$")
  250.                     ELSE PutS("ELSIF"); GenCond(s1); PutS(" THEN$")
  251.                     END;
  252.                     Sets.Unite(s1, checked);
  253.                     GenCode(gn2.p1, indent + 2, s1);
  254.                     gp2 := gn2.p2
  255.                 END;
  256.                 IF ~ equal THEN
  257.                     GenErrorMsg(altErr, curSy, errNr);
  258.                     Indent(indent); PutS("ELSE Error("); PutI(errNr); PutS(")$")
  259.                 END;
  260.                 Indent(indent); PutS("END;$")
  261.         | CRT.iter:
  262.                 CRT.GetNode(gn.p1, gn2);
  263.                 Indent(indent); PutS("WHILE");
  264.                 IF gn2.typ = CRT.wt THEN
  265.                     CRT.CompExpected(ABS(gn2.next), curSy, s1);
  266.                     CRT.CompExpected(ABS(gn.next), curSy, s2);
  267.                     CRT.GetSym(gn2.p1, sn);
  268.                     PutS(" WeakSeparator("); PutI(gn2.p1); PutS(", "); PutI(NewCondSet(s1)); 
  269.                     PutS(", "); PutI(NewCondSet(s2)); PutS(") ");
  270.                     Sets.Clear(s1); (*for inner structure*)
  271.                     IF gn2.next > 0 THEN gp2 := gn2.next ELSE gp2 := 0 END
  272.                 ELSE
  273.                     gp2 := gn.p1; CRT.CompFirstSet(gp2, s1); GenCond(s1)
  274.                 END;
  275.                 PutS(" DO$");
  276.                 GenCode(gp2, indent + 2, s1);
  277.                 Indent(indent); PutS("END;$")
  278.         | CRT.opt:
  279.                 CRT.CompFirstSet(gn.p1, s1);
  280.                 IF ~ Sets.Equal(checked, s1) THEN
  281.                     Indent(indent); PutS("IF"); GenCond(s1); PutS(" THEN$");
  282.                     GenCode(gn.p1, indent + 2, s1);
  283.                     Indent(indent); PutS("END;$")
  284.                 ELSE GenCode(gn.p1, indent, checked)
  285.                 END
  286.         END; (*CASE*)
  287.         IF ~ (gn.typ IN {CRT.eps, CRT.sem, CRT.sync}) THEN Sets.Clear(checked) END;
  288.         gp := gn.next
  289. END GenCode;
  290. PROCEDURE GenCodePragmas;
  291.     VAR i, p: INTEGER; sn: CRT.SymbolNode;
  292.     PROCEDURE P(s1, s2: ARRAY OF CHAR);
  293.     BEGIN
  294.         PutS("      "); PutS(scanner); PutS(s1); PutS(" := "); PutS(scanner); PutS(s2); PutS(";$")
  295.     END P;
  296. BEGIN
  297.     i := CRT.maxT + 1;
  298.     WHILE i <= CRT.maxP DO 
  299.         CRT.GetSym(i, sn);
  300.         PutS("      IF sym = "); PutI(i); PutS(" THEN$"); CopySourcePart(sn.semPos, 9); PutS("$      END;$");
  301.         INC(i)
  302.     END;
  303.     P(".nextPos", ".pos"); P(".nextCol", ".col"); P(".nextLine", ".line"); P(".nextLen", ".len")
  304. END GenCodePragmas;
  305. PROCEDURE GenProcedureHeading (sn: CRT.SymbolNode; forward: BOOLEAN);
  306. BEGIN
  307.     PutS("PROCEDURE ");
  308.     IF forward THEN Texts.Write(syn, "^") END;
  309.     PutS(sn.name);
  310.     IF sn.attrPos.beg >= 0 THEN 
  311.         Texts.Write(syn, "("); CopySourcePart(sn.attrPos, 0); Texts.Write(syn, ")")
  312.     END;
  313.     PutS(";$")
  314. END GenProcedureHeading;
  315. PROCEDURE GenForwardRefs;
  316.     VAR sp: INTEGER; sn: CRT.SymbolNode;
  317. BEGIN
  318.     IF ~ CRT.ddt[5] THEN
  319.         sp := CRT.firstNt;
  320.         WHILE sp <= CRT.lastNt DO (* for all nonterminals *)
  321.             CRT.GetSym (sp, sn); GenProcedureHeading(sn, TRUE);
  322.             INC(sp)
  323.         END;
  324.         Texts.WriteLn(syn)
  325. END GenForwardRefs;
  326. PROCEDURE GenProductions;
  327.     VAR sn: CRT.SymbolNode; checked: CRT.Set;
  328. BEGIN
  329.     curSy := CRT.firstNt;
  330.     WHILE curSy <= CRT.lastNt DO (* for all nonterminals *)
  331.         CRT.GetSym (curSy, sn); GenProcedureHeading (sn, FALSE);
  332.         IF sn.semPos.beg >= 0 THEN CopySourcePart(sn.semPos, 2); PutS(" $") END; 
  333.         PutS("BEGIN$"); Sets.Clear(checked);
  334.         GenCode (sn.struct, 2, checked); 
  335.         PutS("END "); PutS(sn.name); PutS(";$$");
  336.         INC (curSy);
  337.     END;
  338. END GenProductions;
  339. PROCEDURE InitSets;
  340.     VAR i, j: INTEGER;
  341. BEGIN
  342.     i := 0; CRT.GetSet(0, symSet[0]);
  343.     WHILE i <= maxSS DO 
  344.         j := 0;
  345.         WHILE j <= CRT.maxT DIV Sets.size DO
  346.             PutS("  symSet["); PutI(i); PutS(", ");PutI(j); 
  347.             PutS("] := {"); PutSet(symSet[i, j]); PutS("};$");
  348.             INC(j)
  349.         END;
  350.         INC(i) 
  351. END InitSets;
  352. PROCEDURE *Show(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
  353. BEGIN END Show;
  354. PROCEDURE GenCompiler*;
  355.     VAR errNr, i: INTEGER; checked: CRT.Set;
  356.             gn: CRT.GraphNode; sn: CRT.SymbolNode;
  357.             parser: ARRAY 32 OF CHAR;
  358.             t: Texts.Text; pos: LONGINT; 
  359.             ch1, ch2: CHAR;
  360. BEGIN
  361.     CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
  362.     COPY(sn.name, parser); i := Length(parser); parser[i] := "P"; parser[i+1] := 0X;
  363.     COPY(parser, scanner); scanner[i] := "S";
  364.     NEW(t); Texts.Open(t, "Parser.FRM"); Texts.OpenReader(fram, t, 0);
  365.     IF t.len = 0 THEN
  366.         Texts.WriteString(w, "Parser.FRM not found"); Texts.WriteLn(w);
  367.         Texts.Append(Oberon.Log, w.buf); HALT(99)
  368.     END;
  369.     Texts.OpenWriter(err); Texts.WriteLn(err);
  370.     i := 0;
  371.     WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END;
  372.     (*----- write *P.Mod -----*)
  373.     Texts.OpenWriter(syn);
  374.     NEW(t); t.notify := Show; Texts.Open(t, ""); 
  375.     CopyFramePart("-->modulename"); PutS(parser);
  376.     CopyFramePart("-->scanner"); PutS(scanner);
  377.     IF CRT.importPos.beg >= 0 THEN PutS(", "); CopySourcePart(CRT.importPos, 0) END;
  378.     CopyFramePart("-->constants");
  379.     PutS("maxP        = "); PutI(CRT.maxP); PutS(";$");
  380.     PutS("  maxT        = "); PutI(CRT.maxT); PutS(";$");
  381.     PutS("  nrSets = ;$"); Texts.Append(t, syn.buf); pos := t.len - 2;
  382.     CopyFramePart("-->declarations"); CopySourcePart(CRT.semDeclPos, 0);
  383.     CopyFramePart("-->errors"); PutS(scanner); PutS(".Error(n, "); PutS(scanner); PutS(".nextPos)");
  384.     CopyFramePart("-->scanProc");
  385.     IF CRT.maxT = CRT.maxP THEN PutS(scanner); PutS(".Get(sym)")
  386.     ELSE
  387.         PutS("LOOP "); PutS(scanner); PutS(".Get(sym);$");
  388.         PutS("    IF sym > maxT THEN$");
  389.         GenCodePragmas;
  390.         PutS("    ELSE EXIT$");
  391.         PutS("    END$");
  392.         PutS("END$")
  393.     END;
  394.     CopyFramePart("-->productions"); GenForwardRefs; GenProductions;
  395.     CopyFramePart("-->parseRoot"); Sets.Clear(checked); GenCode (CRT.root, 2, checked);
  396.     CopyFramePart("-->initialization"); InitSets;
  397.     CopyFramePart("-->modulename"); PutS(parser); Texts.Write(syn, ".");
  398.     Texts.Append(t, syn.buf); Texts.Append(t, err.buf);
  399.     PutI(maxSS+1); (*if no set, maxSS = -1*) Texts.Insert(t, pos, syn.buf);
  400.     i := Length(parser); parser[i] := "."; parser[i+1] := "M"; parser[i+2] := "o"; parser[i+3] := "d"; parser[i+4] := 0X;
  401.     Texts.Close(t, parser)
  402. END GenCompiler;
  403. PROCEDURE WriteStatistics*;
  404. BEGIN
  405.     Texts.WriteInt (w, CRT.maxT + 1, 0); Texts.WriteString(w, " t, ");
  406.     Texts.WriteInt (w, CRT.maxSymbols - CRT.firstNt + CRT.maxT + 1, 0); Texts.WriteString(w, " syms, ");
  407.     Texts.WriteInt (w, CRT.nNodes, 0); Texts.WriteString(w, " nodes, ");
  408.     Texts.WriteInt (w, maxSS, 0); Texts.WriteString(w, "sets");
  409.     Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
  410. END WriteStatistics;
  411. PROCEDURE Init*;
  412. BEGIN
  413.     errorNr := -1; maxSS := 0  (*symSet[0] reserved for all SYNC sets*)
  414. END Init;
  415. BEGIN
  416.     Texts.OpenWriter(w)
  417. END CRX.
  418.